perm filename LI.SAI[SYS,ALS] blob sn#001162 filedate 1972-05-26 generic text, type T, neo UTF8
00010	BEGIN "LISTEN"
00020	DEFINE ⊂="COMMENT";	⊂ 5/16/72;
00030	⊂	This is a fast version of lis.sai;
00090	
00100	LABEL LZZZZ;
00110	REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00120	
00130	REQUIRE "PREPAR[SYS,THO]" LOAD_MODULE;
00140	REQUIRE "SIG[1,ALS]" LOAD_MODULE;
00160	FORTRAN REAL PROCEDURE SQRT(REAL X);
00170	FORTRAN REAL PROCEDURE ALOG10(REAL X);
00180	FORTRAN REAL PROCEDURE COS(REAL X);
00190	FORTRAN REAL PROCEDURE SIN(REAL X);
00200	REQUIRE "FFT8X[1,ALS]" LOAD_MODULE;
00210	EXTERNAL FORTRAN PROCEDURE FRXFM(REFERENCE INTEGER M;REFERENCE REAL X,Y);
00230	 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
00240	
00250	EXTERNAL PROCEDURE PREPARE;
00260	EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00270	EXTERNAL PROCEDURE TIMSET;
00280	EXTERNAL REAL PROCEDURE RUNTIM;
00290	EXTERNAL STRING PROCEDURE INCHWL;
00310	
00320	DEFINE BPS="12";
00330	DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323",TABSIZ="7400",LISSIZ="1000",INSIZ="24";
00340	DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
00350	DEFINE LBYT="ILDB(LBPT)";
00360	DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
00370	DEFINE TBLSIZ="250";
00380	
00390	STRING FILEL,FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3;
00400	INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00410	INTERNAL INTEGER ARRAY TABLES[0:TABSIZ];
00420	INTERNAL INTEGER ARRAY PHLIST,HLIST[00:63];
00430	INTERNAL INTEGER ARRAY LIST[0:LISSIZ];
00440	INTERNAL INTEGER ARRAY FLIST[0:35];
00450	INTEGER ARRAY LFILE[0:'177];
00460	INTERNAL REAL ARRAY A,B,C[0:256];
00470	REAL X,SX;
00480	REAL ARRAY WINDOW[0:256];
00500	INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
00510	INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
00520	INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF,EOFA,BRK;
00530	INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
00540	INTEGER H,I,J,K,L;
00550	INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
00560	INTERNAL INTEGER SEGC,SEGMRK,SEGSAV;
00570	INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
00580	INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H,  INL,INH,NZRNG,  FP1L,FP1H,FP2L,FP2H,
00590	            ILPB,ILPC,  IHPB,IHPC ;
00600	INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
00610	INTERNAL INTEGER ARRAY TABLET[0:TBLSIZ];
00620	INTERNAL INTEGER TFLAG;
00630	INTERNAL INTEGER ZEROF,ZEROC;
00640	
00650	LABEL START;
00660	LABEL LABELA,LABELB,LABELC,ZZZZ;
00670	STRING READ1,READ2,PREHINT,STEPX,STPMOD;
00680	INTEGER HINCNT,HCOUNT,HINDEX;
00690	⊂	****SET UP****;
     

00970	INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
00980	BEGIN
00990	COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES  THE SINGLE VARIATE
01000	COMPLEX TRANSFORM ;
01010	INTEGER K,NK,NH;
01020	REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
01030	NH←N%2;  R←3.1415926536/N;
01040	DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
01050	DC←-0.5*R; CK←1.0;  SK←0;
01060	IF EVALUATE THEN
01070	BEGIN
01080	CK←-1.0; DC←-DC;
01090	END
01100	ELSE
01110	BEGIN
01120	A[N]←A[0]; B[N]←B[0];
01130	END;
01140	FOR K←0 STEP 1 UNTIL NH DO
01150	BEGIN
01160		NK←N-K;
01170		AA←A[K]+A[NK]; AB←A[K]-A[NK];
01180		BA←B[K]+B[NK]; BB←B[K]-B[NK];
01190		RE←CK*BA+SK*AB;  IM←SK*BA-CK*AB;
01200		B[NK]←IM-BB; B[K]←IM+BB;
01210		A[NK]←AA-RE; A[K]←AA+RE;
01220		DC←R*CK+DC; CK←CK+DC;
01230		DS←R*SK+DS; SK←SK+DS;
01240	END;
01250	END "XRTRAN";
     

00010	COMMENT		MACROS;
00020	DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00030	DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00040	DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00050	DEFINE TIL="STEP 1 UNTIL";
00060	DEFINE BDSK="'10",GPH="'11",DSKO="GPH",HP="'7",HPLIST="'6",MUS="'4",ED="'3";
00070	INTEGER K.,J.; ⊂ USED IN MACROS;
00080	DEFINE ERROR(I)="OUT(TTY,""ERROR""&CVS(I))";
00090	DEFINE ISQRT(I)="(K.←(I)↑0.5)";
00100	DEFINE ODD(I)="((I) MOD 2)", EVEN(I)="¬ODD(I)";
00110	DEFINE ABS(I)="(IF I<0 THEN -I ELSE I)";
00120	DEFINE NONNEG(I)="(IF I<0 THEN 0 ELSE I)";
00130	DEFINE TRACE(N)="OUTSTR(""[""&CVS(N)&""]""(";
00140	DEFINE LTRACE(N)="OUTSTR(CR&LF&""[""&CVS(N)&""]"")";
00150	DEFINE FTRACE(N)=
00160	  "BEGIN INTEGER F1,F2; GETFORMAT(F1,F2); SETFORMAT(0,7);
00170	   OUTSTR(""[""&CVF(N)&""]""); SETFORMAT(F1,F2) END";
00180	DEFINE DATE="DATIME(""DATE"")", TIME="DATIME(""TIME"")";
00190	DEFINE MOVEADR(ADR,ARRAY)="QUICK_CODE MOVE 11,ARRAY;MOVEM 11,ADR;END";
00200	DEFINE PI="3.141592653",PICON="(PI/180)";
00210	DEFINE INFINITY="'377777777777";
00220	STRING PARMS; ⊂ HOLDS CONTENTS OF PARMFILE;
00230	
00240	INTERNAL PROCEDURE SETBR;
00250	BEGIN
00260	  SETBREAK(1,CR,LF,"IN");
00270	  SETBREAK(2,CR&",",LF&TB&" ","IN");
00280	  SETBREAK(3,NULL,NULL,"IN");
00290	  SETBREAK(4,CR&TB&" ",LF&",","IN");
00300	  SETBREAK(5,CR,LF,"ISP"); ⊂ SKIP CR&LF, KEEP LINE NBR AND TAB;
00310	  SETBREAK(6,CR&TB&" ",LF&".,","IN");
00320	  SETBREAK(7,NULL,0,"I"); ⊂ TO REMOVE NULL CHARACTERS FROM STRING;
00330	  SETBREAK(8, "=←;[("&CR , LF&" ])" , "IN");
00340	  SETBREAK(9,NULL,0&" "&CR&LF&TB,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE
00350	    NUMBERS, NULLS, BLANKS, CR`S, LF`S, TB`S;
00360	  SETBREAK(10," "&TB&CR,"0123456789"&LF,"IN");
00370	  SETBREAK(11,NULL,0,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE NUMBERS,
00380	    AND NULLS;
00390	END "SETBR";
00400	
00410	
00420	INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00430	BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00440	  BOOLEAN NF;
00450	  LOOKUP(CHAN,FILENAME,NF);
00460	  WHILE NF DO
00470	  BEGIN
00480	    OUTSTR(CR&LF&"Can't find "&FILENAME&". File=");
00490	    FILENAME ← INPUT(TTY,1);
00500	    LOOKUP(CHAN,FILENAME,NF)
00510	  END;
00520	END "LOOKIN";
01270	
01280	STRING PROCEDURE HEADER;
01290	BEGIN STRING H1,H2; INTEGER I,J,K;
01300	   IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; RETURN(PREHINT) END 
01310	                  ELSE WHILE HCOUNT=0 DO BEGIN "XX"
01320	  I←LFILE[HINDEX];  K←LDB(POINT(7,I,30)); J←SEGC-K; 
01330	 
01340	   IF I=0 THEN BEGIN PREHINT←""; HCOUNT←99; RETURN(PREHINT) END;
01350	   IF J ≥ 0 THEN BEGIN "LATCH"
01360	          H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
01370	          H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
01380	   IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
01390	      HCOUNT←HCOUNT-J;
01400				    HINDEX←HINDEX+1; RETURN(PREHINT); DONE 
01410				END
01420	 		 ELSE BEGIN PREHINT←""; HCOUNT←LDB(POINT(5,I,35));
01430	     HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE;
01440	 			END;
01450					   END "LATCH";
01460			PREHINT←""; RETURN(PREHINT); END "XX";
01470	END "HEADER";
01480	
     

00010	SETBR;
00020	UPCNT←3;
00030	FILEL←"LIST1";
00040	FILEI←"TOO1.DAT[1,THO]"; OPT1←"N"; OPT2←"N"; OPT3←"0";  M←8; INFLAG←0;
00050	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00060	CLOSE(CHAN1);
00070	  OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00080	  LOOKUP(CHAN1,"TABLES.DAT",0);
00090	ARRYIN(CHAN1,INSUB[0],INSIZ);
00100	ARRYIN(CHAN1,INDIV[0],INSIZ);
00110	ARRYIN(CHAN1,INCNT[0],INSIZ);
00120	ARRYIN(CHAN1,INNAM[0],INSIZ);
00130	ARRYIN(CHAN1,FLIST[0],36);
00140	ARRYIN(CHAN1,PHLIST[0],64);
00150	ARRYIN(CHAN1,HLIST[0],64);
00160	ARRYIN(CHAN1,TABLES[0],TABSIZ);
00170	ARRYIN(CHAN1,TABLET[0],TBLSIZ);
00180	
00190	CLOSE(CHAN5); CLOSE(CHAN6);
00200	OPEN(CHAN5,"DSK",'10,10,0,0,0,EOF);
00210	LOOKUP(CHAN5,"SIGLST.DAT",0);
00220	ARRYIN(CHAN5,LIST[0],LISSIZ);
00230	INTOT←WORDIN(CHAN5);
00240	RELEASE(CHAN5);
00250	
00260	START:
00270	    IF (TFILEI←STRIN("Data file list("&FILEL&") = "))≠"" THEN FILEL←TFILEI;
00290	CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00300	LOOKUP(CHAN5,FILEL,1); EOFA←0;
00320	
00330	    M←8;
00340	N←2↑M;  NF←2*N;
00350	FOR I←0 STEP 1 UNTIL N DO
00360	 WINDOW[I]←(1-COS((2*PI*I)/N))/2;
00370	
00380	N←2↑M;
00390	STPMOD←STRIN(CRLF&"Should HINTS be listed on scope? (Y or CR) = ");
00410	OUTSTR(CRLF&"Shift DATABUF by WORDS = ");
00420	DATSHIFT←CVD(INCHWL); ⊂  USE TO TEST PHASE SENSITIVITY OF LEARNING;
00425	OUTSTR(CRLF);
00430	WHILE EOFA=0 DO BEGIN "LISTREAD"
00435	HINDEX←21; HCOUNT←HINCNT←0; OPT1←"Y"; OPT2←"N"; STEPX←"Y";
00440	LABELB:		FILEI←INPUT(CHAN5,1);
00450		CLOSE(CHAN4);
00460	OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00470	LOOKIN(CHAN4,FILEI);
00480	EOF←0; SEGC←0; SEGCNT←0;
00490	LABELC:		ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
00500	SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
00505	
00510	IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00520	OUTSTR("Data file "&FILEI&" with "&CVS(SEGTOT)&" half segments"&CRLF);
00540	⊂ **** SET PARAMETER RANGES 
00550	THE PARA LIMITS ARE (DOUBLE CHECK)  F1=200/800  F2=700/2050  F3=2000/3200
00560	    NP=800/1500  NZRNG=NP+/-500 ?
00570	    FP1=1800/3200   FP2=3200/5000   LPE=300/450  HPE=2500/3000 ;
00580	⊂  *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00590	   SX←RATE/N;  I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX; I2H←2050./SX+.5;
00600	   I3L←1950./SX; I3H←3250./SX+.5; 
00610	   INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
00620	   FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
00630	   ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
00640	BPTFST←POINT(BPS,DATBUF[0],-1);
00650	IF DATSHIFT>0 THEN 
00660	ARRYIN(CHAN4,DATBUF[0],DATSHIFT);
00670	ARRYIN(CHAN4,DATBUF[0],BUFEXS);
00680	SEGMRK←SEGC←K←1;
00690	WHILE EOF=0 DO
00700	  BEGIN
00710	    IF SEGC>SEGTOT THEN DONE;
00720	    ARRYIN(CHAN4,DATBUF[BUFEXS],DATSIZ);
00730	
00740	      IF EOF≠0 THEN
00750		BEGIN
00760		  J←EOF LAND '777777;
00770		  FOR I←J STEP 1 UNTIL N-1 DO DATBUF[I]←0;
00780		END;
00790	IF SEGMRK<SEGC+30 THEN BEGIN "FOUND"
00800	K←1;
00810	
00820	  BPT←BPTFST; SEGSAV←SEGC;
00830	LZZZZ:	WHILE K≤6*DATSIZ%N DO BEGIN
00840	IF (J←SEGMRK-SEGC)>0 THEN BEGIN
00850	 FOR I←1 STEP 1 UNTIL J DO BEGIN
00860	  BPT←BPTSAV+42; L←ILDB(BPT); L←ILDB(BPT); BPTSAV←BPT; END;
00870	 K←K+J; SEGC←SEGMRK; END;
00880	IF SEGC>SEGTOT THEN DONE;
00890	 IF K>6*DATSIZ%N THEN DONE;
00900	
00910	BPTSAV←BPT;
00920	
00930	I←0; WHILE I≥0 DO BEGIN
00940	READ1←HEADER; IF STPMOD="Y" THEN OUTSTR(" ("&CVS(SEGC)&")"&READ1);
00950	IF READ1="" THEN BEGIN SEGMRK←SEGC+1; DONE END;
00960	  J←CVSIX(READ1);
00970	  FOR I←0 STEP 1 UNTIL 63 DO BEGIN 
00980	    IF PHLIST[I]=0 THEN BEGIN SEGMRK←SEGC+1;OUTSTR("Hint not identified for segment "&CVS(SEGC)&CRLF);DONE END;
00990	    IF PHLIST[I]=J THEN BEGIN
01000		 HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
01010	  END;
01020	IF I<64 THEN BEGIN SEGMRK←SEGC+1; DONE END;
01030	 END;
01040	IF READ1≠"" THEN BEGIN
01045	HINCNT←HINCNT+1;
01050	 J←I←ZEROC←0; A[J]←BYTE*WINDOW[I]; B[J]←BYTE*WINDOW[I+1]; J←J+1;
01060		IF B[J]<A[J] THEN ZEROF←0 ELSE ZEROF←1;
01070	FOR I←2 STEP 2 UNTIL N-1 DO
01080	 BEGIN
01090	  A[J]←BYTE*WINDOW[I];
01100	IF A[J]<B[J-1] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01110	  B[J]←BYTE*WINDOW[I+1];
01120	IF B[J]<A[J] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01130	  J←J+1;
01140	 END;
01150	FRXFM(M-1,A[0],B[0]);
01160	XRTRAN(A,B,N/2,FALSE);
01170	FOR I←0 STEP 1 UNTIL N/2 DO C[I]←5.*ALOG10(A[I]↑2+B[I]↑2);
01180	END;		⊂ End of first IF READ1="" ;
01190	IF READ1≠"" THEN BEGIN
01200	 PREPARE;
01210	
01220	ZZZZ: SIG(P);
01410	END; 		⊂ END of second IF READ1≠"" ;
01420	IF SEGMRK>SEGSAV+6*DATSIZ%N THEN DONE;
01430	END;		⊂ End of WHILE K≤ ;
01440		END "FOUND";
01450	SEGC←SEGSAV+6*DATSIZ%N; K←1;
01460	FOR I←0 STEP 1 UNTIL BUFEXS-1 DO DATBUF[I]←DATBUF[I+DATSIZ];
01470	FOR I←BUFEXS STEP 1 UNTIL BUFSIZ-1 DO DATBUF[I]←0;
01480	END;
01490	CLOSE(CHAN1);
01500	OPEN(CHAN2,"DSK",'10,0,10,0,0,0);
01510	ENTER(CHAN2,"TABLES.DAT",0);
01520	ARRYOUT(CHAN2,INSUB[0],INSIZ);
01530	ARRYOUT(CHAN2,INDIV[0],INSIZ);
01540	ARRYOUT(CHAN2,INCNT[0],INSIZ);
01550	ARRYOUT(CHAN2,INNAM[0],INSIZ);
01560	ARRYOUT(CHAN2,FLIST[0],36);
01570	ARRYOUT(CHAN2,PHLIST[0],64);
01580	ARRYOUT(CHAN2,HLIST[0],64);
01590	ARRYOUT(CHAN2,TABLES[0],TABSIZ);
01600	ARRYOUT(CHAN2,TABLET[0],TBLSIZ);
01610	CLOSE(CHAN2);
01615	IF STPMOD="Y" THEN OUTSTR(CRLF);
01620	OUTSTR("Tables have been saved with "&CVS(HINCNT)&" hints found"&CRLF);
01630	END "LISTREAD";
01640	GO TO START;
01650	END "LISTEN";